COMMENT ⊗   VALID 00011 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	.SBTTL	data structure processing routines
C00005 00003		Create a data block of length LENG with ID NEW.
C00007 00004
C00008 00005		delete data block pointed to by OLD and merge if possible
C00010 00006		garbage collection routines
C00013 00007	.SBTTL	Monitor command routines	
C00015 00008	
C00017 00009	
C00020 00010	
C00022 00011	
C00024 ENDMK
C⊗;
.SBTTL	data structure processing routines

;	Data structure is composed of variable length blocks.  Each
;	block has a three word header as follows:
;		1   pointer to first word of block in front of it
;		    0 if first block
;		2   number of words in block (including header)
;		3   block ID (0 if deleted block

;	STRUSE points to first block created (0 if none).  ENDUSE points
;	to last block created (0 if none).  STRFRE points to first word
;	of free storage (word following last block).  ENDFRE points to
;	last word of free storage.  Deleted blocks are flagged and left
;	in place.  New blocks are created from smallest deleted block
;	equal to or larger than size needed.  If none, free core is used
;	to create a new block.  If there is not enough free core, garbage
;	collection occurs.  Flag DELFLG tells us if there are any deleted
;	blocks.  This is not the most efficient method but it is easy to
;	code and has little overhead unless their are lots of small blocks.



;	Search data blocks for ID on stack and replace ID with address of
;	block (0 if ID not found) skipping over header words

SEARCH:	MOV STRUSE,A		;start of data blocks
	BEQ NONE		;no data blocks
SLOOP:	CMP 2(SP),4(A)		;compare IDs
	BEQ OK			;found a match
	ADD 2(A),A		;get next block
	CMP A,STRFRE		;test for end of data blocks
	BNE SLOOP
NONE:	CLR 2(SP)		;no match - clear arg
	RTS PC

OK:	ADD #6,A		;skip over header
	MOV A,2(SP)		;match - store address in arg
	RTS PC
;	Create a data block of length LENG with ID NEW.
;	Replace NEW with address of block (0 if not enough room)

CREATE:	TST DELFLG
	BEQ NODEL		;no deleted blocks - skip search
	CLR B			;B points to best block found
	MOV #HCOR,C		;C is length of best block found
	MOV STRUSE,A		;A points to current block
CLOOP:	TST 4(A)
	BNE CNEXT		;test for deleted block
	CMP LENG,2(A)		;deleted - test length
	BGT CNEXT		;too short
	CMP 2(A),C		;ok - test against best
	BGT CNEXT		;too long
	MOV 2(A),C		;ok - save a best block
	MOV A,B
CNEXT:	ADD 2(A),A		;get next block
	CMP A,STRFRE		;test for end
	BNE CLOOP
	TST B
	BEQ NODEL		;no suitable blocks found
	DEC DELFLG		;this deleted block now in use
	MOV NEW,4(B)		;store ID
	MOV B,NEW		;replace ID with address in NEW
	MOV C,A
	SUB LENG,A		;number of extra bytes
	CMP #6,A
	BLE BRK			;≥6, break up
	RTS PC			;use entire block

BRK:	MOV LENG,2(NEW)		;break block into two blocks
	MOV B,-(SP)
	ADD LENG,B		;start of second block
	MOV (SP)+,(B)		;back link
	MOV A,2(B)		;new count
	CLR 4(B)		;deleted
	INC DELFLG
	ADD B,A			;next block
	CMP A,STRFRE
	BGE BEND		;last block
	MOV B,(A)		;back link to current block
BEND:	RTS PC

NODEL:	MOV ENDFRE,A		;no data blocks can be used
	SUB STRFRE,A		;check for enough free core
	CMP LENG,A
	BLT NOGARB
	TST DELFLG
	BEQ NOCORE		;nothing to garbage collect
	JSR PC,GARCOL		;no - garbage collect
	MOV ENDFRE,A		;and try again
	SUB STRFRE,A
	CMP LENG,A
	BLT NOGARB
NOCORE:	CLR NEW			;still not enough - fail
	RTS PC

NOGARB:	MOV STRFRE,A		;create new block and link
	TST STRUSE
	BNE INTALL
	MOV A,STRUSE		;initialize for first block
INTALL:	MOV ENDUSE,(A)+		;set up header
	MOV LENG,(A)+
	MOV NEW,(A)+
	MOV STRFRE,NEW		;relink data structure
	MOV STRFRE,ENDUSE
	ADD LENG,STRFRE
	RTS PC
;	delete data block pointed to by OLD and merge if possible

DELET:	MOV OLD,A
	INC DELFLG
	CLR 4(A)		; flag block deleted
	MOV (A),C		; get back pointer
	BEQ DSTR		; this is first block
	TST 4(C)		; is preceding block deleted
	BNE DSTR
	ADD 2(A),2(C)		; yes - merge them
	DEC DELFLG
	MOV C,A
	ADD 2(A),A
	MOV C,(A)
	MOV C,A
DSTR:	MOV A,B			; get next block
	ADD 2(B),A
	CMP STRFRE,A
	BLE DNO			; this is last block
	TST 4(A)		; is next block deleted
	BNE DNO1
	ADD 2(A),2(B)		; yes - merge them
	DEC DELFLG
	ADD 2(A),A		; and get next block
	MOV C,(A)		; deposit back pointer
DNO1:	RTS PC

DNO:	MOV B,STRFRE		; last block of list deleted
	DEC DELFLG		; add it to free storage
	MOV (B),ENDUSE
	BEQ DATINT		; no blocks in use - initialize
	RTS PC


;	Initialize data structure when empty

DATINT:	CLR STRUSE	
	CLR ENDUSE
	MOV #FREE,STRFRE
	CLR DELFLG
	RTS PC
;	garbage collection routines

GARCOL:	MOV STRUSE,A		;A is where next used block should go
	MOV A,B			;B is current block being checked
	CLR C			;C is pointer to last block
	CLR DELFLG		;no deletions
	MOV LENG,-(SP)		;save this register
GLOOP:	TST 4(B)		;test for deleted block
	BEQ GDEL
 	CMP A,B			;no - have we deleted anything yet
	BEQ NOPACK		;no 
	MOV 2(B),LENG		;yes - get length of this block
	ASR LENG		;   in words
	MOV A,-(SP)		;save current pointer
PLOOP:	MOV (B)+,(A)+		;move block to new location
	SOB LENG,PLOOP
	MOV C,@(SP)		;back link for moved block
	MOV (SP)+,C		;and save next back link
	BR NEXT

NOPACK:	MOV B,C			;nothing to move - save next back link
	ADD 2(B),A		;skip good block
GDEL:	ADD 2(B),B		;deleted block - skip it
NEXT:	CMP B,STRFRE
	BLT GLOOP
	CMP A,STRUSE
	BNE UPD
	JSR PC,DATINT		;no used block - reinitialize structure
	BR NULL

UPD:	MOV C,ENDUSE		;finished, update pointers to blocks
	MOV A,STRFRE
NULL:	MOV (SP)+,LENG
	RTS PC

FNDEND:	TST ENDFRE		;find highest location useable for free core
	BNE FOUT		; already found
	MOV #FREE,A
FLOOP:	TST 2(A)		; test next location for zero
	BNE FNXT
	ADD #2,A
	CMP A,#HCOR		; test for end of core
	BLT FLOOP
FNXT:	MOV A,ENDFRE		; found - save for future calls
	SUB #FREE-2,A		; get number of free words
	MOV A,ENDUSE		; and tell user
	CRLF
	NUMDEC ENDUSE
	OUTSTR FREMES
	CRLF
FOUT:	RTS PC
.SBTTL	Monitor command routines	

COM1:	MOV IBUF+2,NEW		;get arguments
	MOV IBUF+4,OLD
	MOV IBUF+6,LENG
	CLR OBUF+2		;clear error code and address
	CLR OBUF+4
	ADD #3,LENG		;adjust length for header
	ASL LENG		;and convert to bytes
	TST OLD
	BGT OLDOK
	TST NEW
	BGT NEWOK
NOID:	MOV #20,OBUF+4		;both IDs =0, set warning flag
	BR ERRRET

OLDOK:	MOV OLD,-(SP)		;old ID given, find it
	JSR PC,SEARCH
	MOV (SP)+,OLD
	BNE OLDFND
	BIS #10,OBUF+4		;not found, set error flag
	TST NEW
	BGT NEWOK		;and process new ID
	BR NOID			;  if any

OLDFND:	SUB #6,OLD		;point to header
	TST NEW
	BGT FNDNEW
	JSR PC,DELET		;no new ID, just delete old block
	BR ERRRET

FNDNEW:	MOV NEW,-(SP)		;both old and new ID, find new one
	JSR PC,SEARCH
	TST (SP)
	BEQ USENEW		;new ID does not exist - ok
	SUB #6,(SP)		;point to header
	CMP (SP),OLD
	BEQ USENEW		;new ID = old ID - OK
IGLNEW:	BIS #4,OBUF+4		;new ID already exists - fatal error
	ADD #2,SP		;flush stack
	BR ERRRET

USENEW:	CMP LENG,2(OLD)		;are old and new blocks same size?
	BNE DELOLD		;no (sigh!!)
	MOV NEW,4(OLD)		;yes - use it
	MOV OLD,OBUF+2
	ADD #6,OBUF+2		;skip header
	BR ERRRET


DELOLD:	JSR PC,DELET		;delete old block
	BR NEWSEA		;and go to create a new block

NEWOK:	MOV NEW,-(SP)		;not old ID, search for new ID
	JSR PC,SEARCH
	TST (SP)
	BNE IGLNEW		;new ID must not exist
NEWSEA:	ADD #2,SP		;flush stack
	CMP LENG,#3		;test size
	BGT LENOK
	BIS #2,OBUF+4		;length≤0, fatal error
	BR ERRRET

LENOK:	JSR PC,CREATE		;create a new block
	TST NEW
	BGT CREOK
	BIS #1,OBUF+4
	BR ERRRET		;no room for block

CREOK:	MOV NEW,OBUF+2		;save block address
	ADD #6,OBUF+2		;skip header
	BR ERRRET

; Block status command

COM2:	CLR OBUF+2
	CLR OBUF+4
	MOV IBUF+2,-(SP)	;search for block
	BLE ERRRET		;null id given
	JSR PC,SEARCH
	MOV (SP)+,OBUF+2
	BEQ ERRRET		;does not exist	
	MOV OBUF+2,A
	MOV -4(A),B		;exists, return length also
	ASR B			;convert to words
	SUB #3,B
	MOV B,OBUF+4		;adjust length for header
ERRRET: MOV COMAND,OBUF		;return command
	JMP WAITX

; COMMAND #3 - repack picture data blocks
;	argument is ID of control block of form:

PICT=0		; ID of picture data block to be repacked
NLFT=2		; new X coordinate of left side of rectangle
NTOP=4		; new Y coordinate of top side of rectangle
NSP=6		; new number of samples per line
NLN=10		; new number of lines in picture

;	NLFT will be adjusted out to next word boundary and updated, along
;	with NSP in control block. Excess space in data block, if any,
;	will be returned to free storage.  Argument returned is size, in
;	words, of new picture block, which will have the same address as
;	the old one.  The error word returned is decoded as follows:
;		1	new limits outside old limits - not repacked
;		0	repacking finished
;		-1	did not find control block
;		-2	did not find picture data block

OBYT:	0	; difference in line lengths in bytes
NSIZ:	0	; new picture size in bytes
NWLN:	0	; new # of words/line
LOFFS:	0	; first line of new picture relative to old
SOFFS:	0	; first byte of new picture line relative to old

COM3:	CLR OBUF+2
	CLR OBUF+4
	MOV IBUF+2,-(SP)	; put control block in NEW
	JSR PC,SEARCH
	MOV (SP)+,NEW
	BNE BLKFND
	MOV #-1,OBUF+4		;	error -1, block not found
	BR ERRRET
BLKFND:	MOV PICT(NEW),-(SP)	; put picture block in OLD
	JSR PC,SEARCH
	MOV (SP)+,OLD
	BNE B2FL
	MOV #-2,OBUF+4		; 	error -2, block not found
	BR ERRRET
B2FL:	SUB LEFT(OLD),NLFT(NEW)	; adjust new limits to word boundary
	BGE LAB31
BLKOUT:	MOV #1,OBUF+4		;	error 1 - limits outside old
	BR ERRRET
LAB31:	MOV NLFT(NEW),A
	BIC #3,NLFT(NEW)
	MOV NLFT(NEW),SOFFS
	ASR SOFFS		;	save byte offset
	SUB NLFT(NEW),A
	ADD A,NSP(NEW)
	ADD LEFT(OLD),NLFT(NEW)

	MOV NTOP(NEW),LOFFS	; save line offset
	SUB TOP(OLD),LOFFS
	BLT BLKOUT
	CMP NSP(NEW),NSAMP(OLD)
	BGT BLKOUT
	CMP NLN(NEW),NLIN(OLD)
	BGT BLKOUT
	MOV NSP(NEW),NWLN	; compute new parameters
	ADD #4,NWLN
	ASR NWLN
	ASR NWLN		;	new words per line
	MOV WRDLIN(OLD),OBYT
	SUB NWLN,OBYT
	ASL OBYT		;	bytes/line difference
	MOV NLN(NEW),B
	MUL NWLN,B
	ASL B
	MOV B,NSIZ		;	new picture size
	MOV OLD,A		; set up copy
	ADD PPNTR(OLD),A	;	start of old picture in A
	MOV WRDLIN(OLD),B
	MUL LOFFS,B
	ASL B
	ADD A,B
	ADD SOFFS,B		;	start of new picture in B
	MOV NLN(NEW),LENG	;	line count to copy in LENG
LAB32:	MOV NWLN,C		;	word count to copy in C
LAB33:	MOV (B)+,(A)+		;	this copies
	SOB C,LAB33		;	takes care of full line
	ADD OBYT,B		;	increment pointer to next line
	SOB LENG,LAB32		;	wasn't this easy !!!
	MOV NLFT(NEW),LEFT(OLD)	; copy new parameters
	MOV NTOP(NEW),TOP(OLD)
	MOV NSP(NEW),NSAMP(OLD)
	MOV NLN(NEW),NLIN(OLD)
	MOV NWLN,WRDLIN(OLD)
	MOV NSIZ,PSIZE(OLD)
	ADD PPNTR(OLD),NSIZ	; compute new picture block size
	ADD #6,NSIZ
	SUB #6,OLD
	MOV 2(OLD),LENG		; old block size in LENG
	MOV LENG,C
	SUB NSIZ,LENG		; number of excess words
	CMP #3,LENG
	BGT NOBRK		; not enough - keep old size

	MOV NSIZ,2(OLD)		; break up old block - set new leng
	ADD OLD,C		; 	start of next block
	MOV NSIZ,NEW
	ADD OLD,NEW		;	start of deleted block
	MOV LENG,2(NEW)
	CMP C,STRFRE
	BGE BEND1
	MOV NEW,(C)		;	relink blocks
BEND1:	MOV OLD,(NEW)
	MOV OLD,-(SP)
	MOV NEW,OLD
	JSR PC,DELET
	MOV (SP)+,OLD
NOBRK:	MOV 2(OLD),OBUF+2	; return new block size
	SUB #3,OBUF+2
	JMP ERRRET